{-# OPTIONS -Wall #-}

--------------------------------------------------------------------------------
-- |
-- Module      :  Majalan.Base.Impulse
-- Copyright   :  (c) Stephen Tetley 2014
-- License     :  BSD3
--
-- Maintainer  :  stephen.tetley@gmail.com
-- Stability   :  unstable
-- Portability :  GHC
--
-- Timed impulses with labels.
-- 
-- HImpulseMap for elemetary building, ImpulseMap for processing 
-- and transforming.
-- 
--------------------------------------------------------------------------------

module Majalan.Base.Impulse
  (

    HImpulseMap
  , ImpulseMap
  , unionImpulseMap
  , buildImpulseMap
  , buildImpulseMapH


  , impulseFrameStart
  , impulseFrameEnd
  
  , toImpulseList
  , xreplaceImpulse
  , xzipImpulse
  , xzipImpulseMb

  ) where

import Majalan.Base.Internal.Base
import Majalan.Base.Internal.Utils
import Majalan.Base.Trail

import Control.Applicative hiding ( empty )
import qualified Data.Foldable as F
import qualified Data.Map as M
import qualified Data.Traversable as T



type HImpulseMap a = HMap Seconds a


--------------------------------------------------------------------------------
-- Impulse Map

-- Frame giving start and duration (so end is derivable) 
--
data ImpulseMap a = ImpulseMap 
    { im_frame    :: TimeSpan
    , im_impulses :: M.Map Seconds a
    }
  deriving Show

instance Functor ImpulseMap where
  fmap f (ImpulseMap frm ems) = ImpulseMap frm (fmap f ems)



-- No Monoid instance (cannot create empty TimeSpan).



-- | Union is merge (no displacement).
--
unionImpulseMap :: ImpulseMap a -> ImpulseMap a -> ImpulseMap a
unionImpulseMap (ImpulseMap ts1 im1) (ImpulseMap ts2 im2) = 
    ImpulseMap (unionTimeSpan ts1 ts2) (im1 `M.union` im2)



instance F.Foldable ImpulseMap where
  fold      = F.fold . im_impulses       
  foldr f b = M.foldr f b . im_impulses 
  foldMap f = F.foldMap f . im_impulses


instance T.Traversable ImpulseMap where
  traverse f (ImpulseMap frm ems) = ImpulseMap frm <$> T.traverse f ems


buildImpulseMap :: TimeSpan -> Trail a -> ImpulseMap a
buildImpulseMap ts ma = 
    ImpulseMap { im_frame     = ts
               , im_impulses  = let t0 = tspan_start ts in execTrail t0 ma
               }

buildImpulseMapH :: TimeSpan -> HImpulseMap a -> ImpulseMap a
buildImpulseMapH ts hf = 
    ImpulseMap { im_frame     = ts
               , im_impulses  = toMapH hf
               }


impulseFrameStart :: ImpulseMap a -> Seconds
impulseFrameStart = tspan_start . im_frame

impulseFrameEnd :: ImpulseMap a -> Seconds
impulseFrameEnd im = let start = tspan_start $ im_frame im
                         drn   = tspan_duration $ im_frame im
                     in start + drn



toImpulseList :: ImpulseMap a -> [(Seconds,a)]
toImpulseList = M.toAscList . im_impulses




-- | Cross-zip a list onto an ImpulseMap - will truncate if 
-- either list or ImpulseMap too short.
--


xreplaceImpulse :: [b] -> ImpulseMap a -> ImpulseMap b
xreplaceImpulse xs im@(ImpulseMap {im_impulses = ems }) = 
    im { im_impulses = M.fromAscList . step xs . M.toAscList $ ems }
  where
    step (y:ys) ((k,_):zs) = (k,y) : step ys zs
    step _      _          = []

xzipImpulse :: [a] -> ImpulseMap b -> ImpulseMap (a,b)
xzipImpulse xs im@(ImpulseMap {im_impulses = ems }) = 
    im { im_impulses = M.fromAscList . step xs . M.toAscList $ ems }
  where
    step (y:ys) ((k,z):zs) = (k,(y,z)) : step ys zs
    step _      _          = []


xzipImpulseMb :: [Maybe a] -> ImpulseMap b -> ImpulseMap (a,b)
xzipImpulseMb xs im@(ImpulseMap {im_impulses = ems }) = 
    im { im_impulses = M.fromAscList . step xs . M.toAscList $ ems }
  where
    step (y:ys) ((k,z):zs) = case y of
        Just a -> (k,(a,z)) : step ys zs
        Nothing -> step ys zs

    step _      _          = []
